home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / a_to_d / delftips / ti2854.asc < prev    next >
Encoding:
Text File  |  1996-09-15  |  8.6 KB  |  366 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.   PRODUCT  :  Delphi                                 NUMBER  :  2854
  8.   VERSION  :  All
  9.        OS  :  Windows
  10.      DATE  :  August 17, 1995                          PAGE  :  1/6
  11.  
  12.     TITLE  :  Managing disk volume labels in Delphi
  13.  
  14.  
  15.  
  16.  
  17. This document contains the source code for a unit that is useful for
  18. getting, setting, and deleting volume labels from a floppy or hard disk.
  19. The code for getting a volume label uses the Delphi FindFirst function,
  20. and the code for setting and deleting volume labels involves calling DOS
  21. interrupt 21h, functions 16h and 13h respectively.  Since function 16h
  22. isn't supported by Windows, it must be called through DPMI interrupt 31h,
  23. function 300h.
  24.  
  25. { *** BEGIN CODE FOR VOLLABEL UNIT *** }
  26. unit VolLabel;
  27.  
  28. interface
  29.  
  30. uses Classes, SysUtils, WinProcs;
  31.  
  32. type
  33.   EInterruptError = class(Exception);
  34.   EDPMIError = class(EInterruptError);
  35.   Str11 = String[11];
  36.  
  37. procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
  38. function GetVolumeLabel(Drive: Char): Str11;
  39. procedure DeleteVolumeLabel(Drv: Char);
  40.  
  41. implementation
  42.  
  43. type
  44.   PRealModeRegs = ^TRealModeRegs;
  45.   TRealModeRegs = record
  46.     case Integer of
  47.       0: (
  48.         EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
  49.         Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
  50.       1: (
  51.         DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
  52.         case Integer of
  53.           0: (
  54.             BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.   PRODUCT  :  Delphi                                 NUMBER  :  2854
  69.   VERSION  :  All
  70.        OS  :  Windows
  71.      DATE  :  August 17, 1995                          PAGE  :  2/6
  72.  
  73.     TITLE  :  Managing disk volume labels in Delphi
  74.  
  75.  
  76.  
  77.  
  78.           1: (
  79.             BL, BH, BLH, BHH, DL, DH, DLH, DHH,
  80.             CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
  81.   end;
  82.  
  83.   PExtendedFCB = ^TExtendedFCB;
  84.   TExtendedFCB = Record
  85.     ExtendedFCBflag : Byte;
  86.     Reserved1       : array[1..5] of Byte;
  87.     Attr            : Byte;
  88.     DriveID         : Byte;
  89.     FileName        : array[1..8] of Char;
  90.     FileExt         : array[1..3] of Char;
  91.     CurrentBlockNum : Word;
  92.     RecordSize      : Word;
  93.     FileSize        : LongInt;
  94.     PackedDate      : Word;
  95.     PackedTime      : Word;
  96.     Reserved2       : array[1..8] of Byte;
  97.     CurrentRecNum   : Byte;
  98.     RandomRecNum    : LongInt;
  99.   end;
  100.  
  101. procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs);
  102. { procedure invokes int 31h function 0300h to simulate a real mode }
  103. { interrupt  from protected mode. }
  104. var
  105.   ErrorFlag: Boolean;
  106. begin
  107.   asm
  108.     mov ErrorFlag, 0       { assume success }
  109.     mov ax, 0300h          { function 300h }
  110.     mov bl, Int            { real mode interrupt to execute }
  111.     mov bh, 0              { required }
  112.     mov cx, 0              { stack words to copy, assume zero }
  113.     les di, Regs           { es:di = Regs }
  114.     int 31h                { DPMI int 31h }
  115.     jnc @@End              { carry flag set on error }
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.   PRODUCT  :  Delphi                                 NUMBER  :  2854
  130.   VERSION  :  All
  131.        OS  :  Windows
  132.      DATE  :  August 17, 1995                          PAGE  :  3/6
  133.  
  134.     TITLE  :  Managing disk volume labels in Delphi
  135.  
  136.  
  137.  
  138.  
  139.   @@Error:
  140.     mov ErrorFlag, 1       { return false on error }
  141.   @@End:
  142.   end;
  143.   if ErrorFlag then
  144.     raise EDPMIError.Create('Failed to execute DPMI interrupt');
  145. end;
  146.  
  147. function DriveLetterToNumber(DriveLet: Char): Byte;
  148. { function converts a character drive letter into its numerical equiv. }
  149. begin
  150.   if DriveLet in ['a'..'z'] then
  151.     DriveLet := Chr(Ord(DriveLet) -32);
  152.   if not (DriveLet in ['A'..'Z']) then
  153.     raise EConvertError.CreateFmt('Cannot convert %s to drive number',
  154.                                   [DriveLet]);
  155.   Result := Ord(DriveLet) - 64;
  156. end;
  157.  
  158. procedure PadVolumeLabel(var Name: Str11);
  159. { procedure pads Volume Label string with spaces }
  160. var
  161.   i: integer;
  162. begin
  163.   for i := Length(Name) + 1 to 11 do
  164.     Name := Name + ' ';
  165. end;
  166.  
  167. function GetVolumeLabel(Drive: Char): Str11;
  168. { function returns volume label of a disk }
  169. var
  170.   SR: TSearchRec;
  171.   DriveLetter: Char;
  172.   SearchString: String[7];
  173.   P: Byte;
  174. begin
  175.   SearchString := Drive + ':\*.*';
  176.   { find vol label }
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.   PRODUCT  :  Delphi                                 NUMBER  :  2854
  191.   VERSION  :  All
  192.        OS  :  Windows
  193.      DATE  :  August 17, 1995                          PAGE  :  4/6
  194.  
  195.     TITLE  :  Managing disk volume labels in Delphi
  196.  
  197.  
  198.  
  199.  
  200.   if FindFirst(SearchString, faVolumeID, SR) = 0 then begin
  201.     P := Pos('.', SR.Name);
  202.     if P > 0 then begin                      { if it has a dot... }
  203.       Result := '           ';               { pad spaces between name }
  204.       Move(SR.Name[1], Result[1], P - 1);    { and extension }
  205.       Move(SR.Name[P + 1], Result[9], 3);
  206.     end
  207.     else begin
  208.       Result := SR.Name;                     { otherwise, pad to end }
  209.       PadVolumeLabel(Result);
  210.     end;
  211.   end
  212.   else
  213.     Result := '';
  214. end;
  215.  
  216. procedure DeleteVolumeLabel(Drv: Char);
  217. { procedure deletes volume label from given drive }
  218. var
  219.   CurName: Str11;
  220.   FCB: TExtendedFCB;
  221.   ErrorFlag: WordBool;
  222. begin
  223.   ErrorFlag := False;
  224.   CurName := GetVolumeLabel(Drv);        { get current volume label }
  225.   FillChar(FCB, SizeOf(FCB), 0);         { initialize FCB with zeros }
  226.   with FCB do begin
  227.     ExtendedFCBflag := $FF;              { always }
  228.     Attr := faVolumeID;                  { Volume ID attribute }
  229.     DriveID := DriveLetterToNumber(Drv); { Drive number }
  230.     Move(CurName[1], FileName, 8);       { must enter volume label }
  231.     Move(CurName[9], FileExt, 3);
  232.   end;
  233.   asm
  234.     push ds                              { preserve ds }
  235.     mov ax, ss                           { put seg of FCB (ss) in ds }
  236.     mov ds, ax
  237.     lea dx, FCB                          { put offset of FCB in dx }
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.   PRODUCT  :  Delphi                                 NUMBER  :  2854
  252.   VERSION  :  All
  253.        OS  :  Windows
  254.      DATE  :  August 17, 1995                          PAGE  :  5/6
  255.  
  256.     TITLE  :  Managing disk volume labels in Delphi
  257.  
  258.  
  259.  
  260.  
  261.     mov ax, 1300h                        { function 13h }
  262.     Call DOS3Call                        { invoke int 21h }
  263.     pop ds                               { restore ds }
  264.     cmp al, 00h                          { check for success }
  265.     je @@End
  266.   @@Error:                               { set flag on error }
  267.     mov ErrorFlag, 1
  268.   @@End:
  269.   end;
  270.   if ErrorFlag then
  271.     raise EInterruptError.Create('Failed to delete volume name');
  272. end;
  273.  
  274. procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
  275. { procedure sets volume label of a disk.  Note that this procedure }
  276. { deletes the current label before setting the new one.  This is }
  277. { required for the set function to work. }
  278. var
  279.   Regs: TRealModeRegs;
  280.   FCB: PExtendedFCB;
  281.   Buf: Longint;
  282. begin
  283.   PadVolumeLabel(NewLabel);
  284.   if GetVolumeLabel(Drive) <> '' then           { if has label... }
  285.     DeleteVolumeLabel(Drive);                   { delete label }
  286.   Buf := GlobalDOSAlloc(SizeOf(PExtendedFCB));  { allocate real buffer }
  287.   FCB := Ptr(LoWord(Buf), 0);
  288.   FillChar(FCB^, SizeOf(FCB), 0);               { init FCB with zeros }
  289.   with FCB^ do begin
  290.     ExtendedFCBflag := $FF;                     { required }
  291.     Attr := faVolumeID;                         { Volume ID attribute }
  292.     DriveID := DriveLetterToNumber(Drive);      { Drive number }
  293.     Move(NewLabel[1], FileName, 8);             { set new label }
  294.     Move(NewLabel[9], FileExt, 3);
  295.   end;
  296.   FillChar(Regs, SizeOf(Regs), 0);
  297.   with Regs do begin                            { SEGMENT of FCB }
  298.     ds := HiWord(Buf);                          { offset = zero }
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.   PRODUCT  :  Delphi                                 NUMBER  :  2854
  313.   VERSION  :  All
  314.        OS  :  Windows
  315.      DATE  :  August 17, 1995                          PAGE  :  6/6
  316.  
  317.     TITLE  :  Managing disk volume labels in Delphi
  318.  
  319.  
  320.  
  321.  
  322.     dx := 0;
  323.     ax := $1600;                                { function 16h }
  324.   end;
  325.   RealModeInt($21, Regs);                       { create file }
  326.   if (Regs.al <> 0) then                        { check for success }
  327.     raise EInterruptError.Create('Failed to create volume label');
  328. end;
  329.  
  330. end.
  331. { *** END CODE FOR VOLLABEL UNIT *** }
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362. DISCLAIMER: You have the right to use this technical information
  363. subject to the terms of the No-Nonsense License Statement that
  364. you received with the Borland product to which this information
  365. pertains.
  366.